home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1994 June / PC Plus Super CD coverdisc Issue 93 June 1994.iso / suprdisk / button / button.bas next >
Encoding:
BASIC Source File  |  1994-03-26  |  6.2 KB  |  190 lines
  1. Option Explicit
  2. Option Compare Text
  3.  
  4. 'Button type and state
  5. Type bType
  6.     Group As Integer        'Tool group, Color group or no group
  7.     Down As Integer         'True = Down, False = Up
  8.     stuck As Integer        'True = Stuck down, False = Normal
  9. End Type
  10.  
  11. Type BMP
  12.     ID As Integer           'Used to verify if a bitmap data file is valid
  13.     Changed As Integer      'Flag set when the master bitmap has been altered
  14.     ButtonHeight As Integer
  15.     ButtonWidth As Integer
  16.     Position As Integer     'The current position in the master bitmap
  17.     Border As Integer       'Thickness of borders of buttons on the master bitmap
  18.     Buttons As Integer      'Which buttons to save (up, down & disabled)
  19. End Type
  20. Global BitMap As BMP
  21.  
  22. Type Rect
  23.     rLeft As Integer
  24.     rTop As Integer
  25.     rRight As Integer
  26.     rBottom As Integer
  27. End Type
  28. Global Box As Rect          'Used to hold the values of the corners of the drawing area
  29.  
  30. 'Used to fill the above Rect in one move
  31. Declare Sub SetRect Lib "user" (Box As Rect, ByVal x1%, ByVal y1%, ByVal x2%, ByVal y2%)
  32. 'Used to copy and stretch the pictures
  33. Declare Sub BitBlt Lib "GDI" (ByVal hDestDC%, ByVal X%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop As Long)
  34. Declare Sub StretchBlt Lib "GDI" (ByVal hDestDC%, ByVal X%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal XWidth%, ByVal YHeight%, ByVal dwRop As Long)
  35. 'Gets various system values
  36. Declare Function getSystemMetrics Lib "User" (ByVal intAns%) As Integer
  37.  
  38. Global Editing As Integer
  39. Global HelpItem As Integer          'Used in Cheap_Help
  40. Global B(0 To 2) As picturebox      'Picturebox variable
  41. Global UpDated As Integer           'Flag used to indicate if the disabled button needs re-drawing
  42. Global GroupName As String          'Root name used to save files
  43. Global ButtonChanged As Integer     'Flag used to indicate if the button has changed
  44. Global CurrentDirectory As String   'The directory last used to load or save files
  45. Global CR As String                 'Carriage return/Line feed
  46. Global BitMapLoaded As Integer      'Flag set when a bitmap is loaded
  47.  
  48. 'TOOL VALUES
  49. Global Const T_FILL = 1
  50. Global Const T_PEN = 2
  51. Global Const T_LINE = 3
  52. Global Const T_BOX = 4
  53. Global Const T_BOXFILL = 5
  54. Global Const T_CIRCLE = 6
  55. Global Const T_CIRCLEFILL = 7
  56.  
  57. 'BUTTON VALUES
  58. Global Const NO_GROUP = False
  59. Global Const COLOR_GROUP = 1
  60. Global Const TOOL_GROUP = 2
  61. Global Const TOTAL_BUTTONS = 32
  62. Global Const WIDTH_OF_BUTTONS = 29  '=Width of button + (the border width * 2)
  63. Global Const HEIGHT_OF_BUTTONS = 29 '=height of button + (the border height * 2)
  64.  
  65. 'BitBlt & StretchBlt API Constants
  66. Global Const SRCCOPY = &HCC0020
  67. Global Const SRCAND = &H8800C6
  68. Global Const DSTINVERT = &H550009
  69. Global Const NOTSRCCOPY = &H330008
  70.  
  71. 'GetSystemMetrics API constants
  72. Global Const SM_CXBORDER = 5      'Use to get the thickness in
  73. Global Const SM_CYBORDER = 6      'pixels of the picturebox frames
  74. Global Const SM_MOUSEPRESENT = 19
  75. 'SAVE VALUES
  76. Global Const NOT_SAVED = 32
  77. Global Const CANCEL_SAVE = 16
  78. Global Const SAVED = 0
  79. Global Const S_INDIVIDUAL_FILE = 1
  80. Global Const S_TO_BITMAP = 2
  81. Global Const S_BITMAP = 4
  82. Global Const S_TO_BITMAP_AND_FILE = 8
  83. Global Const S_SHOW_ALL = 15
  84. Global Const SAVE_CHANGES = " changed. Do you want to save the changes?"
  85. Global Const BUT_CHANGED = "The current button has"
  86. Global Const BIT_CHANGED = "The multi-button bitmap has"
  87. Global Const BOTH_CHANGED = "The current button && multi-button bitmap have"
  88. Global Const S_TYPE_INDIVIDUAL = 1
  89. Global Const S_TYPE_BITMAP = 2
  90.  
  91. 'BUTTON NUMBERS
  92. Global Const BUTTON_BLACK = 0
  93. Global Const BUTTON_FILL = 16
  94. Global Const BUTTON_PEN = 17
  95. Global Const BUTTON_LINE = 18
  96. Global Const BUTTON_BOX = 19
  97. Global Const BUTTON_BOXFILL = 20
  98. Global Const BUTTON_CIRCLE = 21
  99. Global Const BUTTON_CIRCLEFILL = 22
  100. Global Const BUTTON_RESIZE = 24
  101. Global Const BUTTON_NEXT = 25
  102. Global Const BUTTON_UPDATE = 26
  103. Global Const BUTTON_SAVE = 27
  104. Global Const BUTTON_CLEAR = 28
  105. Global Const BUTTON_LOAD = 29
  106. Global Const BUTTON_VIEW = 30
  107. Global Const BUTTON_PRINT = 31
  108.  
  109. 'Button ID
  110. Global Const BUTTON_ID = 6313
  111.  
  112. '   I couldn't afford the VB help compiler so
  113. '   this is the next best thing
  114. Sub Cheap_Help (HelpPos As String)
  115.     Dim FilePath As String
  116.     Dim Temp As String
  117.     Dim Msg As String
  118.     Dim HelpFound As Integer
  119.     Dim handle As Integer
  120.  
  121.     If Len(HelpPos) < 1 Then HelpPos = "0"
  122.  
  123.     On Error GoTo NoHelp
  124.     FilePath = app.Path
  125.     If Right$(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
  126.     FilePath = FilePath & "Buttons.aid"
  127.  
  128.     handle = FreeFile
  129.  
  130.     Open FilePath For Input As #handle
  131.         Do Until EOF(handle)
  132.             Line Input #handle, Temp
  133.             If Left$(Temp, Len(HelpPos)) = HelpPos Then
  134.                 HelpFound = True
  135.                 Do
  136.                     Line Input #handle, Temp
  137.                     If Left$(Temp, 1) = Chr$(167) Then Exit Do
  138.                     Msg = Msg & Temp & CR
  139.                 Loop Until EOF(handle)
  140.                 Exit Do
  141.             End If
  142.         Loop
  143.     Close #handle
  144.  
  145.     If HelpFound Then
  146.         frmHelp!tbxHelp = Msg
  147.         frmHelp.Show 1
  148.     Else
  149.         Error 32767
  150.     End If
  151.  
  152. GoOut:
  153. Exit Sub
  154.  
  155. NoHelp:
  156.     Select Case Err
  157.     Case 32767
  158.         Msg = "No help available for that subject"
  159.     Case Else
  160.         Msg = "Unable to load Help" & CR & Error$
  161.     End Select
  162.  
  163.     MsgBox Msg, 0, "Help"
  164.     Resume GoOut
  165.  
  166. End Sub
  167.  
  168. '   Checks that any drawing that's about to be done is
  169. '   inside the drawing area on the button
  170. Function Inside_Array (X As Integer, Y As Integer) As Integer
  171.     Inside_Array = True
  172.     If X < Box.rLeft Or X > Box.rRight Then Inside_Array = False
  173.     If Y < Box.rTop Or Y > Box.rBottom Then Inside_Array = False
  174. End Function
  175.  
  176. '   Centres forms
  177. Sub Position_Form (tForm As Form)
  178.     tForm.Move (Screen.Width - tForm.Width) \ 2, (Screen.Height - tForm.Height) \ 2
  179. End Sub
  180.  
  181. '   Any black pixel on the 'Up' button is plotted on the disabled button
  182. '   as dark grey and a white pixel is drawn to the right and below
  183. '   Any dark grey pixel is copied without change
  184. Sub Update_Button ()
  185.     
  186.     If Not UpDated Then frmUpdate.Show 1
  187.  
  188. End Sub
  189.  
  190.